(**
 * grammar for the interface langauge.
 * @copyright (C) 2021 SML# Development Team.
 * @author Atsushi Ohori
 * @author UENO Katsuhiro
 *)
structure A = Absyn
structure I = AbsynInterface
%%

%decompose (yes)

%blocksize (40)


(*
  2011-12-12 Ohori
  Extended the interface language with
  (1) structure liplication,
      structure id = longid
   and
  (2) a restricted functor application
      structure id = functorid ( structureid)
  In doing this, I eliminated the AND construct in strexp.
  It is confusing and makes grammar and code unnecessarily complicated.
  (The same situation holds in other declarations.)

  2012-1-4 Ohori
  Extended the interface language with
  (3) variable alias declaration
      val id = longid  (VALALIAS_EXTERN below)
  This allows an interface to provide builtin primitives as in
    structure Array =
    struct
      ...
      val sub = SMLSharp.PrimArray.sub
      ...
   end
  where SMLSharp.PrimArray.sub is defined as the primitive Array_sub.
  By this addition, we can effectively inline primitives in the user code.
*)

%name Interface
%header (
structure Interface
)
%footer ()
%verbose
%pos Loc.pos

(* same token set as iml.grm *)
%term EOF
    | ABSTYPE
    | AND
    | ANDALSO
    | ARROW
    | AS
    | ASTERISK
    | AT
    | BAR
    | BUILTIN
    | CASE
    | CHAR of string
    | COLON
    | COMMA
    | DARROW
    | DATATYPE
    | END
    | EQ
    | EQTYPE
    | EQTYVAR of string
    | EXCEPTION
    | FN
    | FUN
    | FUNCTOR
    | HASH
    | SYMBOLICID of string
    | ALPHABETICID of string
    | IN
    | INCLUDE
    | INFIX
    | INFIXR
    | INT of {radix:StringCvt.radix, digits:string}
    | INTLAB of string
    | PREFIXEDLABEL of string
    | LBRACE
    | LBRACKET
    | LOCAL
    | LPAREN
    | NONFIX
    | OF
    | OP
    | OPAQUE
    | PERIOD
    | PERIODS
    | REQUIRE
    | RBRACE
    | RBRACKET
    | RPAREN
    | SEMICOLON
    | SHARING
    | SIG
    | SIGNATURE
    | SPECIAL of string
    | STRING of string
    | STRUCT
    | STRUCTURE
    | TYPE
    | TYVAR of string
    | USE'
    | VAL
    | WHERE
    | WITHTYPE

%nonterm
      id of Symbol.symbol
    | id_noEQ of Symbol.symbol
    | id_noEQSTAR of Symbol.symbol
    | longId of Symbol.longsymbol
(*
      id of string
    | id_noEQ of string
    | id_noEQSTAR of string
    | longId of string list
    | longtyconid of string list
*)
    | tycon of Symbol.symbol
    | strid of Symbol.symbol
    | funid of Symbol.symbol
    | tyvar of A.tvar
    | longtycon of Symbol.longsymbol

    | tyvarCommaList of A.tvar list
    | tyvarseq_noNIL of A.tvar list
    | tyvarseq of A.tvar list
(*
    | valbind_1 of I.valbind
    | valbind of I.valbind list
*)
    | valbind of I.valbind
    | typbind_trans_1 of I.typbind_trans
    | typbind_trans of I.typbind_trans list
    | opaque_impl of I.opaque_impl
    | typbind_1 of I.typbind
    | typbind of I.typbind list
    | eqtypbind_1 of I.typbind
    | eqtypbind of I.typbind list
    | datbind_t of I.datbind
(*
    | datbind_opq of I.datbind
    | datbind_tList of I.datbind list
*)
    | datbind_1 of I.datbind
    | datbinds of I.datbind list
    | datbind of I.datbind list * I.typbind_trans list
    | conname of Symbol.symbol
    | conbind_1 of I.conbind
    | conbind of I.conbind list
    | exbind_1 of I.exbind
    | exbind of I.exbind list
    | dec of I.idec
    | strexp of I.istrexp
    | strbind of I.strbind
    | strdec of I.idec
    | strdecs of I.idec list
    | sigdec of I.sigbind list
    | funParam of I.funParam
    | funbindLeft of Symbol.symbol * I.funParam
                     (* (I.constraint * A.sigexp) option *)
    | funbind of I.funbind
    | fundec of I.itopdec
    | precLevel of string option
    | vidList of Symbol.symbol list
    | infixDec of I.itopdec
    | topdec of I.itopdec
    | topdecs of I.itopdec list
    | sigdec' of A.topdec
    | sigdecs of A.topdec list
    | require_options of Symbol.symbol list
    | requires of I.irequire list
    | includes of (RequirePath.path * I.loc) list
    | top of I.itop

    | kindSeq of {properties : string list,
                  recordKind : (RecordLabel.label * A.ty) list option}

    | overloadExp of I.overloadCase
    | overloadInst of I.overloadInstance
(*
    | overloadMatch of I.overloadMatch list
*)
    | overloadMatch of {instTy: A.ty, instance: I.overloadInstance} list

    | lab of RecordLabel.label
    | sigid of Symbol.symbol
(*
    | longstrid of string list
*)
    | longstrid of Symbol.longsymbol
    | longstrsymbol of Symbol.longsymbol
(*
    | constraint of I.constraint
*)
    | sigidlist of Symbol.symbol list
    | valdesc of (Symbol.symbol * A.ty) list
    | typdesc of (A.tvar list * Symbol.symbol) list
    | typdescAlias of (A.tvar list * Symbol.symbol * A.ty) list
    | datdesc_1 of
        A.tvar list * Symbol.symbol * (Symbol.symbol * A.ty option * A.loc) list * A.loc
    | datdesc of
        (A.tvar list * Symbol.symbol * (Symbol.symbol * A.ty option * A.loc) list * A.loc) list
    | condesc_1 of Symbol.symbol * A.ty option * A.loc
    | condesc of (Symbol.symbol * A.ty option * A.loc) list
    | exdesc of (Symbol.symbol * A.ty option * A.loc) list
    | strdesc of (Symbol.symbol * A.sigexp) list
    | spec_1 of A.spec
    | spec of A.spec
    | tyEquation of Symbol.longsymbol list
    | strEquation of Symbol.longsymbol list
    | whereSpec of A.tvar list * Symbol.longsymbol * A.ty
    | sigexpWhere of A.sigexp
        (* (A.tvar list * Symbol.longsymbol * A.ty) list *)
    | sigexp of A.sigexp
    | sigexp_AND of A.sigexp
    | sigbind of I.sigbind list
    | tyrow of (RecordLabel.label * A.ty) list
(*
    | atty of A.ty
    | tyargList of A.ty list
    | tyCommaList of A.ty list
    | tyStarList of A.ty list
    | tuplety of A.ty
    | ty of A.ty
*)

(* 2013-1-19 ohori. poly ty stuff copied from iml.grm *)
    | ty of A.ty
    | ty0 of A.ty
    | ty1 of A.ty
    | tyseq_comma of A.ty list
    | tyseq of A.ty list
    | tytuple of A.ty list
    | tuplety of A.ty
    | poly_ty of A.ty
    | poly_ty1 of A.ty
    | poly_tyrow of (RecordLabel.label * A.ty) list
    | poly_tytuple of A.ty list
    | kinded_tyvar of A.tvar * A.tvarKind
    | kinded_tyvarseq of (A.tvar * A.tvarKind) list
    | kinded_tyvarseq_without_paren of (A.tvar * A.tvarKind) list
    | kinded_tyvarseq_comma of (A.tvar * A.tvarKind) list
(* end of poly ty stuff *)


%start top
%eop EOF
%noshift EOF

%nonassoc DARROW
%nonassoc BAR


(* for error recovery *)
%keyword AND AS BUILTIN CASE DATATYPE END EQTYPE EXCEPTION FUNCTOR IN
         INFIX INFIXR NONFIX OF OP OPAQUE REQUIRE SHARING SIG SIGNATURE
        STRUCT STRUCTURE TYPE VAL WHERE
%value TYVAR ("")
%value SYMBOLICID ("")
%value ALPHABETICID ("")
%change -> VAL | -> LPAREN | -> END | -> SEMICOLON

%%

(******** basic structures ********)

id_noEQSTAR
        : SYMBOLICID
          (Symbol.mkSymbol SYMBOLICID (SYMBOLICIDleft, SYMBOLICIDright))
        | ALPHABETICID
          (Symbol.mkSymbol ALPHABETICID (ALPHABETICIDleft, ALPHABETICIDright))

id_noEQ
        : id_noEQSTAR
          (id_noEQSTAR)
        | ASTERISK
          (Symbol.mkSymbol "*" (ASTERISKleft, ASTERISKright))

id
        : id_noEQ
          (id_noEQ)
        | EQ
          (Symbol.mkSymbol "=" (EQleft, EQright))

tycon
        : id
          (id)

strid
        : ALPHABETICID
          (Symbol.mkSymbol ALPHABETICID (ALPHABETICIDleft, ALPHABETICIDright))

funid
        : ALPHABETICID
          (Symbol.mkSymbol ALPHABETICID (ALPHABETICIDleft, ALPHABETICIDright))

sigid
        : ALPHABETICID
          (Symbol.mkSymbol ALPHABETICID (ALPHABETICIDleft, ALPHABETICIDright))

tyvar
        : TYVAR
          ({symbol = Symbol.mkSymbol TYVAR (TYVARleft, TYVARright),
            isEq = false})
        | EQTYVAR
          ({symbol = Symbol.mkSymbol EQTYVAR (EQTYVARleft, EQTYVARright),
            isEq = true})

longId
        : id
          ([id])
        | ALPHABETICID PERIOD longId
          (Symbol.mkSymbol 
	      ALPHABETICID 
              (ALPHABETICIDleft, ALPHABETICIDright) :: longId)

longtycon
        : id_noEQSTAR
          ([id_noEQSTAR])
        | ALPHABETICID PERIOD longId
          (Symbol.mkSymbol 
	      ALPHABETICID 
              (ALPHABETICIDleft, ALPHABETICIDright) :: longId)
longstrid
        : ALPHABETICID
          ([Symbol.mkSymbol 
	      ALPHABETICID 
              (ALPHABETICIDleft, ALPHABETICIDright)])
        | ALPHABETICID PERIOD longstrid
          (Symbol.mkSymbol 
	      ALPHABETICID 
              (ALPHABETICIDleft, ALPHABETICIDright) :: longstrid)

longstrsymbol
        : longstrid
          (longstrid)

sigidlist
        : sigid sigid
          ([sigid1, sigid2])
        | sigid sigidlist
          (sigid :: sigidlist)

tyvarCommaList
        : tyvar
          ([tyvar])
        | tyvar COMMA tyvarCommaList
          (tyvar :: tyvarCommaList)

tyvarseq_noNIL
        : tyvar
          ([tyvar])
        | LPAREN tyvarCommaList RPAREN
          (tyvarCommaList)

tyvarseq
        : (* none *)
          (nil)
        | tyvarseq_noNIL
          (tyvarseq_noNIL)

(*
runtimeTy       : id
                    (id)
*)

(******** The Interface Language ********)

(*
valbind_1       : vid COLON ty
                    ({symbol = vid, body = I.VAL_EXTERN {ty = ty},
                      loc = (vidleft, tyright)})
                | vid COLON poly_ty
                    ({symbol = vid, body = I.VAL_EXTERN {ty = poly_ty},
                      loc = (vidleft, poly_tyright)})
                | vid EQ longsymbol
                (* 2012-1-4 ohori: variable alias in interface added *)
                    ({symbol = vid, body = I.VALALIAS_EXTERN longsymbol,
                      loc = (vidleft, longsymbolright)})
                | vid EQ BUILTIN VAL vid COLON ty
                    ({symbol = vid1,
                      body = I.VAL_BUILTIN {builtinSymbol = vid2, ty = ty},
                      loc = (vidleft, tyright)})
                | vid EQ overloadExp
                    ({symbol = vid, body = I.VAL_OVERLOAD overloadExp,
                      loc = (vidleft, overloadExpright)})

valbind         : valbind_1
                    ([valbind_1])
                | valbind_1 AND valbind
                    (valbind_1 :: valbind)
*)
valbind
        : id COLON ty
          ({symbol = id,
            body = I.VAL_EXTERN {ty = ty},
            loc = (idleft, tyright)})
        | id COLON poly_ty
          ({symbol = id,
            body = I.VAL_EXTERN {ty = poly_ty},
            loc = (idleft, poly_tyright)})
        | id EQ longId
          (* 2012-1-4 ohori: variable alias in interface added *)
          ({symbol = id,
            body = I.VALALIAS_EXTERN longId,
            loc = (idleft, longIdright)})
        | id EQ BUILTIN VAL id COLON ty
          ({symbol = id1,
            body = I.VAL_BUILTIN {builtinSymbol = id2, ty = ty},
            loc = (id1left, tyright)})
        | id EQ BUILTIN VAL id COLON poly_ty
          ({symbol = id1,
            body = I.VAL_BUILTIN {builtinSymbol = id2, ty = poly_ty},
            loc = (id1left, poly_tyright)})
        | id EQ overloadExp
          ({symbol = id,
            body = I.VAL_OVERLOAD overloadExp,
            loc = (idleft, overloadExpright)})

typbind_trans_1
        : tyvarseq tycon EQ ty
          ({tyvars = tyvarseq,
            symbol = tycon,
            ty = ty,
            loc = (tyvarseqleft, tyright)})

typbind_trans
        : typbind_trans_1
          ([typbind_trans_1])
        | typbind_trans_1 AND typbind_trans
          (typbind_trans_1 :: typbind_trans)

opaque_impl
        : longId
          (case Symbol.longsymbolToString longId of
             "*" => I.IMPL_TUPLE
           | _ => I.IMPL_TY longId)
        | ARROW
          (I.IMPL_FUNC)
        | LBRACE RBRACE
          (I.IMPL_RECORD)

typbind_1
        : tyvarseq tycon LPAREN EQ opaque_impl RPAREN
          (I.OPAQUE {eq = false,
                     tyvars = tyvarseq,
                     symbol = tycon,
                     runtimeTy = opaque_impl,
                     loc = (tyvarseqleft, RPARENright)})
        | typbind_trans_1
          (I.TRANSPARENT typbind_trans_1)

typbind
        : typbind_1
          ([typbind_1])
        | typbind_1 AND typbind
          (typbind_1 :: typbind)

eqtypbind_1
        : tyvarseq tycon LPAREN EQ opaque_impl RPAREN
          (I.OPAQUE {eq = true,
                     tyvars = tyvarseq,
                     symbol = tycon,
                     runtimeTy = opaque_impl,
                     loc = (tyvarseqleft, RPARENright)})

eqtypbind
        : eqtypbind_1
          ([eqtypbind_1])
        | eqtypbind_1 AND eqtypbind
          (eqtypbind_1 :: eqtypbind)

datbind_t
        : tycon EQ conbind
          ({tyvars = nil, symbol = tycon, conbind = conbind, loc=(tyconleft,conbindright)})
        | tyvarseq_noNIL tycon EQ conbind
          ({tyvars = tyvarseq_noNIL, symbol = tycon, conbind = conbind, loc = (tyvarseq_noNILleft,conbindright)})

(*
datbind_opq     : tycon LPAREN EQ conbind RPAREN
                    ({tyvars = nil, symbol = tycon,
                      conbind = conbind, opacity = I.OPAQUE_NONEQ})
                | tycon LPAREN EQ conbind RPAREN AS EQTYPE
                    ({tyvars = nil, symbol = tycon,
                      conbind = conbind, opacity = I.OPAQUE_EQ})
                | tyvarseq_noNIL tycon LPAREN EQ conbind RPAREN
                    ({tyvars = tyvarseq_noNIL, symbol = tycon,
                      conbind = conbind, opacity = I.OPAQUE_NONEQ})
                | tyvarseq_noNIL tycon LPAREN EQ conbind RPAREN AS EQTYPE
                    ({tyvars = tyvarseq_noNIL, symbol = tycon,
                      conbind = conbind, opacity = I.OPAQUE_EQ})
*)

(*
datbind_tList   : datbind_t
                    ([datbind_t])
                | datbind_t AND datbind_tList
                    (datbind_t :: datbind_tList)
*)

datbind_1
        : datbind_t
          (datbind_t)
(*
                | datbind_opq
                    (datbind_opq)
*)

datbinds
        : datbind_1
          ([datbind_1])
        | datbind_1 AND datbinds
          (datbind_1 :: datbinds)

datbind
        : datbinds
          ((datbinds, nil))
        | datbinds WITHTYPE typbind_trans
          ((datbinds, typbind_trans))
(*
                | datbinds LPAREN AND datbind_tList RPAREN
                    (datbinds
                     @ map (fn {tyvars, symbol, conbind, opacity} =>
                               {tyvars=tyvars, symbol=tycon,
                                conbind=conbind, opacity=I.OPAQUE_NONEQ})
                           datbind_tList)
*)

conname
        : id
          (id)
        | OP id
          (id)

conbind_1
        : conname
          ({symbol = conname, ty = NONE, loc=(connameleft,connameright)})
        | conname OF ty
          ({symbol = conname, ty = SOME ty, loc=(connameleft,tyright)})

conbind
        : conbind_1
          ([conbind_1])
        | conbind_1 BAR conbind
          (conbind_1 :: conbind)

exbind_1
        : conname
          (I.EXNDEF
             {symbol = conname, ty = NONE, loc = (connameleft, connameright)})
        | conname OF ty
          (I.EXNDEF
             {symbol = conname, ty = SOME ty, loc = (connameleft, tyright)})
        | conname EQ longId
          (I.EXNREP {symbol = conname,
                     longsymbol = longId,
                     loc = (connameleft, longIdright)})

exbind
        : exbind_1
          ([exbind_1])
        | exbind_1 AND exbind
          (exbind_1 :: exbind)

dec
        : VAL valbind
          (I.IVAL valbind)
        | TYPE typbind
          (I.ITYPE typbind)
        | EQTYPE eqtypbind
          (I.ITYPE eqtypbind)
        | DATATYPE datbind
          (I.IDATATYPE {datbind = #1 datbind,
                        withType = #2 datbind,
                        loc = (DATATYPEleft, datbindright)})
        | DATATYPE tycon EQ DATATYPE longtycon
          (I.ITYPEREP {symbol = tycon,
                       longsymbol = longtycon,
                       loc = (DATATYPEleft, longtyconright)})
(*
                | DATATYPE tycon LPAREN EQ DATATYPE longtycon RPAREN
                    (I.ITYPEREP {symbol=tycon, longsymbol=longtycon,
                                 opacity=I.OPAQUE_NONEQ,
                                 loc=(DATATYPEleft, longtyconright)})
                | DATATYPE tycon LPAREN EQ DATATYPE longtycon RPAREN AS EQTYPE
                    (I.ITYPEREP {symbol=tycon, longsymbol=longtycon,
                                 opacity=I.OPAQUE_EQ,
                                 loc=(DATATYPEleft, longtyconright)})
*)
        | EXCEPTION exbind
          (I.IEXCEPTION exbind)
        | DATATYPE tycon EQ BUILTIN DATATYPE tycon
          (I.ITYPEBUILTIN {symbol = tycon1,
                           builtinSymbol = tycon2,
                           loc = (DATATYPEleft, tycon2right)})
(*
                | DATATYPE tycon LPAREN EQ BUILTIN DATATYPE tycon RPAREN
                    (I.ITYPEBUILTIN {symbol=tycon1, builtinSymbol=tycon2,
                                     opacity=I.OPAQUE_NONEQ,
                                     loc=(DATATYPEleft, tycon2right)})
                | DATATYPE tycon LPAREN EQ BUILTIN DATATYPE tycon RPAREN
                  AS EQTYPE
                    (I.ITYPEBUILTIN {symbol=tycon1, builtinSymbol=tycon2,
                                     opacity=I.OPAQUE_EQ,
                                     loc=(DATATYPEleft, tycon2right)})
*)

strexp
        : STRUCT strdecs END
          (I.ISTRUCT {decs = strdecs, loc = (STRUCTleft, ENDright)})
        | longId
          (I.ISTRUCTREP {longsymbol = longId,
                         loc = (longIdleft, longIdright)})
        | funid LPAREN longId RPAREN
          (I.IFUNCTORAPP {functorSymbol = funid,
                          argument = longId,
                          loc = (longIdleft, RPARENright)})

strbind
        : strid EQ strexp
          ({symbol = strid, strexp = strexp, loc = (stridleft, strexpright)})

strdec
        : dec
          (dec)
        | STRUCTURE strbind
          (I.ISTRUCTURE strbind)

strdecs
        : (* none *)
          (nil)
        | SEMICOLON strdecs
          (strdecs)
        | strdec strdecs
          (strdec :: strdecs)

sigdec
        : SIGNATURE sigbind
          (sigbind)

funParam
        : strid COLON sigexp
          (I.FUNPARAM_FULL {symbol = strid, sigexp = sigexp})
        | spec  (* derived form *)
          (I.FUNPARAM_SPEC spec)

funbindLeft
        : funid LPAREN funParam RPAREN
          ((funid, funParam))

funbind
        : funbindLeft EQ strexp
          ({functorSymbol = #1 funbindLeft,
            param = #2 funbindLeft,
            strexp = strexp,
            loc = (funbindLeftleft, strexpright)})

fundec
        : FUNCTOR funbind
          (I.IFUNDEC funbind)

precLevel
        : INT
          (SOME (#digits INT))
        | INTLAB
          (SOME INTLAB)
        | (* none *)
          (NONE)

vidList
        : id
          ([id])
        | id vidList
          (id :: vidList)

infixDec
        : INFIX precLevel vidList
          (I.IINFIX {fixity = I.INFIXL precLevel,
                     symbols = vidList,
                     loc = (INFIXleft, vidListright)})
        | INFIXR precLevel vidList
          (I.IINFIX {fixity = I.INFIXR precLevel,
                     symbols = vidList,
                     loc = (INFIXRleft, vidListright)})
        | NONFIX vidList
          (I.IINFIX {fixity = I.NONFIX,
                     symbols = vidList,
                     loc = (NONFIXleft, vidListright)})

topdec
        : strdec
          (I.IDEC strdec)
        | fundec
          (fundec)
        | infixDec
          (infixDec)

topdecs
        : (* none *)
          (nil)
        | topdec topdecs
          (topdec :: topdecs)
        | SEMICOLON topdecs
          (topdecs)

sigdec'
        : sigdec
          (A.TOPDECSIG
             (map (fn {symbol, sigexp, loc} => (symbol, sigexp)) sigdec,
              (sigdecleft, sigdecright)))

sigdecs
        : (* none *)
          (nil)
        | sigdec' sigdecs
          (sigdec' :: sigdecs)
        | SEMICOLON sigdecs
          (sigdecs)

require_options
        : (* none *)
          (nil)
        | id require_options
          (id :: require_options)

requires
        : (* none *)
          (nil)
        | REQUIRE STRING require_options requires
          (I.REQUIRE
             (RequirePath.fromString STRING,
              require_options,
              (REQUIREleft, STRINGright))
           :: requires)
        | REQUIRE LOCAL STRING require_options requires
          (I.LOCAL_REQUIRE
             (RequirePath.fromString STRING,
              require_options,
              (REQUIREleft, STRINGright))
           :: requires)
        | USE' LOCAL STRING requires
          (I.LOCAL_USE
             (RequirePath.fromString STRING,
              (USE'left, STRINGright))
           :: requires)
        | SEMICOLON requires
          (requires)

includes
        : INCLUDE STRING
          ([(RequirePath.fromString STRING, (INCLUDEleft, STRINGright))])
        | INCLUDE STRING includes
          ((RequirePath.fromString STRING, (INCLUDEleft, STRINGright))
           :: includes)

top
        : requires topdec topdecs
          (I.INTERFACE {requires = requires, provide = topdec :: topdecs})
        | requires
          (I.INTERFACE {requires = requires, provide = nil})
        | includes sigdecs
          (I.INCLUDES {includes = includes, topdecs = sigdecs})
        | sigdec' sigdecs
          (I.INCLUDES {includes = nil, topdecs = sigdec' :: sigdecs})

(******** overload declaration ********)

overloadExp
        : CASE tyvar IN ty OF overloadMatch
          ({tyvar = tyvar,
            expTy = ty,
            matches = overloadMatch,
            loc = (CASEleft, overloadMatchright)})

overloadInst
        : overloadExp
          (I.INST_OVERLOAD overloadExp)
        | longId
          (I.INST_LONGVID {longsymbol = longId})
        | LPAREN overloadInst RPAREN
          (overloadInst)

overloadMatch
        : ty DARROW overloadInst
          ([{instTy = ty, instance = overloadInst}])
        | ty DARROW overloadInst BAR overloadMatch
          ({instTy = ty, instance = overloadInst} :: overloadMatch)

(******** types and signatures: same as The Definition of Standard ML ********)

lab
        : id
          (RecordLabel.fromString (Symbol.symbolToString id))
        | INTLAB
          (RecordLabel.fromString INTLAB)
        | PREFIXEDLABEL
          (RecordLabel.fromString PREFIXEDLABEL)
        | STRING
          (RecordLabel.fromString STRING)

(*
constraint      : COLON
                    (I.SIG_TRANSPARENT)
                | OPAQUE
                    (I.SIG_OPAQUE)
*)


valdesc
        : id COLON ty
          ([(id, ty)])
        | id COLON ty AND valdesc
          ((id, ty) :: valdesc)
(* 2013-1-19 ohori *)
        | id COLON poly_ty
          ([(id, poly_ty)])
        | id COLON poly_ty AND valdesc
          ((id, poly_ty) :: valdesc)

typdesc
        : tyvarseq tycon
          ([(tyvarseq, tycon)])
        | tyvarseq tycon AND typdesc
          ((tyvarseq, tycon) :: typdesc)

typdescAlias
        : tyvarseq tycon EQ ty (* derived form *)
          ([(tyvarseq, tycon, ty)])
        | tyvarseq tycon EQ ty AND typdescAlias (* derived form *)
          ((tyvarseq, tycon, ty) :: typdescAlias)

datdesc_1
        : tycon EQ condesc
          ((nil, tycon, condesc, (tyconleft, condescright)))
        | tyvarseq_noNIL tycon EQ condesc
          ((tyvarseq_noNIL, tycon, condesc, (tyvarseq_noNILleft, condescright)))

datdesc
        : datdesc_1
          ([datdesc_1])
        | datdesc_1 AND datdesc
          (datdesc_1 :: datdesc)

condesc_1
        : id
          ((id, NONE, (idleft, idright)))
        | id OF ty
          ((id, SOME ty, (idleft, tyright)))

condesc
        : condesc_1
          ([condesc_1])
        | condesc_1 BAR condesc
          (condesc_1 :: condesc)

exdesc
        : condesc_1
          ([condesc_1])
        | condesc_1 AND exdesc
          (condesc_1 :: exdesc)

strdesc
        : strid COLON sigexp
          ([(strid, sigexp)])
        | strid COLON sigexp_AND strdesc
          ((strid, sigexp_AND) :: strdesc)

spec_1
        : VAL valdesc
          (A.SPECVAL (valdesc, (VALleft, valdescright)))
        | TYPE typdesc
          (A.SPECTYPE (typdesc, (TYPEleft, typdescright)))
        | TYPE typdescAlias
          (A.SPECDERIVEDTYPE (typdescAlias, (TYPEleft, typdescAliasright)))
        | EQTYPE typdesc
          (A.SPECEQTYPE (typdesc, (EQTYPEleft, typdescright)))
        | DATATYPE datdesc
          (A.SPECDATATYPE (datdesc, (DATATYPEleft, datdescright)))
        | DATATYPE tycon EQ DATATYPE longtycon
          (A.SPECREPLIC (tycon, longtycon, (DATATYPEleft, longtyconright)))
        | EXCEPTION exdesc
          (A.SPECEXCEPTION (exdesc, (EXCEPTIONleft, exdescright)))
        | STRUCTURE strdesc
          (A.SPECSTRUCT (strdesc, (STRUCTUREleft, strdescright)))
        | INCLUDE sigexp
          (A.SPECINCLUDE (sigexp, (INCLUDEleft, sigexpright)))
        | INCLUDE sigidlist (* derived form *)
          (A.SPECDERIVEDINCLUDE (sigidlist, (INCLUDEleft, sigidlistright)))

spec
        : (* none *)
          (A.SPECEMPTY)
        | spec spec_1
          (A.SPECSEQ (spec, spec_1, (specleft, spec_1right)))
        | spec SEMICOLON
          (spec)
        | spec SHARING TYPE tyEquation
          (A.SPECSHARE (spec, tyEquation, (specleft, tyEquationright)))
        | spec SHARING strEquation (* derived form *)
          (A.SPECSHARESTR (spec, strEquation, (specleft, strEquationright)))

tyEquation
        : longtycon EQ longtycon
          ([longtycon, longtycon2])
        | longtycon EQ tyEquation
          (longtycon :: tyEquation)

strEquation
        : longstrsymbol EQ longstrsymbol
          ([longstrsymbol, longstrsymbol2])
        | longstrsymbol EQ strEquation
          (longstrsymbol :: strEquation)

whereSpec
        : TYPE tyvarseq longtycon EQ ty
          ((tyvarseq, longtycon, ty))

sigexpWhere
        : sigexp WHERE whereSpec
          (A.SIGWHERE (sigexp, whereSpec, (sigexpleft, whereSpecright)))
        | sigexpWhere AND whereSpec (* derived form *)
          (* ohori 2012-12-22: normalized to make the same representation
             as iml.grm *)
          (A.SIGWHERE (sigexpWhere, whereSpec,
                      (sigexpWhereleft, whereSpecright)))

sigexp
        : SIG spec END
          (A.SIGEXPBASIC (spec, (SIGleft, ENDright)))
        | sigid
          (A.SIGID (sigid, (sigidleft, sigidright)))
        | sigexpWhere
          (sigexpWhere)

sigexp_AND
        : SIG spec END AND
          (A.SIGEXPBASIC (spec, (SIGleft, ENDright)))
        | sigid AND
          (A.SIGID (sigid, (sigidleft, sigidright)))
        | sigexpWhere AND
          (sigexpWhere)
(*
                    (A.SIGWHERE (#1 sigexpWhere, #2 sigexpWhere,
                                 (sigexpWhereleft, sigexpWhereright)))
*)

sigbind
        : sigid EQ sigexp
          ([{symbol = sigid,
             sigexp = sigexp,
             loc = (sigidleft, sigexpright)}])
        | sigid EQ sigexp_AND sigbind
          ({symbol = sigid,
            sigexp = sigexp_AND,
            loc = (sigidleft, sigexp_ANDright)} :: sigbind)

tyrow
        : lab COLON ty
          ([(lab, ty)])
        | lab COLON ty COMMA tyrow
          ((lab, ty) :: tyrow)

(* 2013-1-19 ohori replaced the following with the corresponding
   ones in iml.grm.
atty            : tyvar
                    (A.TYID (tyvar, (tyvarleft, tyvarright)))
                | LBRACE RBRACE
                    (A.TYRECORD (nil, (LBRACEleft, RBRACEright)))
                | LBRACE tyrow RBRACE
                    (A.TYRECORD (tyrow, (LBRACEleft, RBRACEright)))
                | tyargList longtycon
                    (A.TYCONSTRUCT (tyargList, longtycon,
                                    (longtyconleft, longtyconright)))
                | LPAREN ty RPAREN
                    (ty)
(*
                    (A.TYTUPLE (nil, (LPARENleft, RPARENright)))
*)
tyargList       : (* none *)
                    (nil)
                | atty
                    ([atty])
                | LPAREN ty COMMA tyCommaList RPAREN
                    (ty :: tyCommaList)

tyCommaList     : ty
                    ([ty])
                | ty COMMA tyCommaList
                    (ty :: tyCommaList)

tyStarList      : atty ASTERISK atty
                    ([atty, atty2])
                | atty ASTERISK tyStarList
                    (atty :: tyStarList)

tuplety         : atty
                    (atty)
                | tyStarList
                    (A.TYTUPLE (tyStarList, (tyStarListleft, tyStarListright)))

ty              : tuplety
                    (tuplety)
                | tuplety ARROW ty
                    (A.TYFUN (tuplety, ty, (tupletyleft, tyright)))
*)

ty0
        : tyvar
          (A.TYID (tyvar, (tyvarleft, tyvarright)))
        | LBRACE tyrow RBRACE
          (A.TYRECORD {ifFlex = false,
                       fields = tyrow,
                       loc = (LBRACEleft, RBRACEright)})
        | LBRACE RBRACE
          (A.TYRECORD {ifFlex = false,
                       fields = [],
                       loc = (LBRACEleft, RBRACEright)})
        | LPAREN ty RPAREN
          (ty)

ty1
        : ty0
          (ty0)
        | tyseq longtycon
          (A.TYCONSTRUCT (tyseq, longtycon, (tyseqleft, longtyconright)))

tyseq
        : ty1
          ([ty1])
        | LPAREN tyseq_comma RPAREN
          (tyseq_comma)
        | (* none *)
          (nil)

tyseq_comma
        : ty COMMA ty
          ([ty1, ty2])
        | ty COMMA tyseq_comma
          (ty :: tyseq_comma)

tytuple
        : ty1 ASTERISK tytuple
          (ty1 :: tytuple)
        | ty1 ASTERISK ty1
          ([ty11, ty12])

tuplety
        : ty1
          (ty1)
        | tytuple
          (A.TYTUPLE (tytuple, (tytupleleft, tytupleright)))

ty
        : tuplety
          (tuplety)
        | tuplety ARROW ty
          (A.TYFUN (tuplety, ty, (tupletyleft, tyright)))

(*
  2013-1-19 ohori following poly ty stuff are copied from iml.grm
*)
poly_tyrow
        : lab COLON poly_ty
          ([(lab, poly_ty)])
        | lab COLON poly_ty COMMA poly_tyrow
          ((lab, poly_ty) :: poly_tyrow)
        | lab COLON poly_ty COMMA tyrow
          ((lab, poly_ty) :: tyrow)
        | lab COLON ty COMMA poly_tyrow
          ((lab, ty) :: poly_tyrow)

poly_ty1
        : LBRACE poly_tyrow RBRACE
          (A.TYRECORD {ifFlex = false,
                       fields = poly_tyrow,
                       loc = (LBRACEleft, RBRACEright)})
        | LPAREN poly_ty RPAREN
          (poly_ty)
        | LBRACKET kinded_tyvarseq_without_paren PERIOD ty RBRACKET
          (A.TYPOLY (kinded_tyvarseq_without_paren,
                     ty,
                     (LBRACKETleft, RBRACKETright)))
        | LBRACKET kinded_tyvarseq_without_paren PERIOD poly_ty RBRACKET
          (A.TYPOLY (kinded_tyvarseq_without_paren,
                     poly_ty,
                     (LBRACKETleft, RBRACKETright)))

poly_tytuple
        : poly_ty1 ASTERISK poly_tytuple
          (poly_ty1 :: poly_tytuple)
        | poly_ty1 ASTERISK tytuple
          (poly_ty1 :: tytuple)
        | poly_ty1 ASTERISK poly_ty1
          ([poly_ty11, poly_ty12])
        | poly_ty1 ASTERISK ty1
          ([poly_ty1, ty1])
        | ty1 ASTERISK poly_tytuple
          (ty1 :: poly_tytuple)
        | ty1 ASTERISK poly_ty1
          ([ty1, poly_ty1])

poly_ty
        : tuplety ARROW poly_ty
          (A.TYFUN (tuplety, poly_ty, (tupletyleft, poly_tyright)))
        | poly_tytuple
          (A.TYTUPLE (poly_tytuple, (poly_tytupleleft, poly_tytupleright)))
        | poly_ty1
          (poly_ty1)

kindSeq
        : HASH LBRACE RBRACE
          ({properties = nil, recordKind = SOME nil})
        | HASH LBRACE tyrow RBRACE
          ({properties = nil, recordKind = SOME tyrow})
        | HASH ALPHABETICID
          ({properties = [ALPHABETICID], recordKind = NONE})
        | HASH ALPHABETICID kindSeq
          ({properties = ALPHABETICID :: #properties kindSeq,
            recordKind = #recordKind kindSeq})

kinded_tyvar
        : tyvar
          (tyvar, A.UNIV (nil, (tyvarleft, tyvarright)))
        | tyvar kindSeq
          (tyvar,
           case kindSeq of
             {properties, recordKind = NONE} =>
             A.UNIV (properties, (kindSeqleft, kindSeqright))
           | {properties, recordKind = SOME recordKind} =>
             A.REC ({properties = properties, recordKind = recordKind},
                    (kindSeqleft, kindSeqright)))

kinded_tyvarseq_without_paren
        : kinded_tyvar
          ([kinded_tyvar])
        | kinded_tyvar COMMA kinded_tyvarseq_without_paren
          (kinded_tyvar::kinded_tyvarseq_without_paren)

(* end of poly ty stuff *)
